:- import "%%/lib/expression.sl" #
:- import "%%/lib/scanner.sl" #

Parse.File .filename .rules :-
	stream.readFile IN.SL.FILE .filename,
	Parse.Stream IN.SL.FILE .rules,
	stream.close IN.SL.FILE #

	-- Got to be a rule set (not a term)
Parse.String .string .rules :-
	stream.createBuffer .buffer,
	stream.write .buffer .string,
	Parse.Stream .buffer .rules,
	stream.close .buffer #

Parse.Stream .stream .rules :-
	scanner.new .scanner,
	scanner.twoCharSymbols .scanner (
		":-", "=>", "<=", "- ", ">=", "--", "-=", "=-",
	),
	scanner.lineCommenter .scanner (SYM "--"),
	scanner.openCommenter .scanner (SYM "-="),
	scanner.closeCommenter .scanner (SYM "=-"),
	,
	parser.new .parser,
	parser.scanner .parser .scanner,
	parser.operators .parser (
		SEP (SYM "|" ) LEFT , DEF (SYM ":-") LEFT ,
		CUT (SYM "!" ) LEFT , DED (SYM "=>") LEFT ,
		OR  (SYM ";" ) LEFT , AND (SYM "," ) LEFT ,
		LE  (SYM "<=") LEFT , LT  (SYM "<" ) LEFT ,
		GE  (SYM ">=") LEFT , GT  (SYM ">" ) LEFT ,
		EQU (SYM "=" ) LEFT , ADD (SYM "+" ) LEFT ,
		SUB (SYM "- ") RIGHT, MUL (SYM "*" ) LEFT ,
		DIV (SYM "/" ) RIGHT, MOD (SYM "%" ) RIGHT,
		PWR (SYM "^" ) LEFT ,
	),
	parser.nodeParser .parser Parse.ExpressionNode,
	set.pointer PARSER .parser
	,
	scan.readFrom .scanner .stream,
	Parse.Rules .parser .rules,
	unset PARSER,
	parser.dispose .parser,
	scanner.dispose .scanner ! #

Parse.Rules .parser $ :-
	parser.scanner .parser .sc,
	scan.EOF .sc #
Parse.Rules .parser (.rule, .remains) :-
	once (Parse.Rule .parser .rule) ! Parse.Rules .parser .remains #

Parse.Rule .parser (Q .tree) :- -- A query
	parser.scanner .parser .sc,
	scan.match .sc (SYM "?"),
	parse.expression .parser .tree,
	scan.match .sc (SYM "#") #
Parse.Rule .parser .tree :-
	parse.expression .parser .tree,
	parser.scanner .parser .sc,
	scan.match .sc (SYM "#") #
Parse.Rule .parser . :-
	Error "Unparsable token",
	parser.scanner .parser .sc,
	scan.next .sc #

	-- Tuples as expression element
Parse.ExpressionNode .parser .ret :-
	Parse.Tuple .parser .tuple,
	length .tuple .len,
	select (.len = 0 => .ret = $) -- Nil
	(.len = 1 => nth .tuple 0 .ret) -- Single atom
	(.ret = .tuple) # -- Otherwise, real tuple

Parse.Tuple .parser .tuple :-
	length .empty 0, -- Starts from zero and build up
	Parse.TupleRemains .parser .empty .tuple ! #

Parse.TupleRemains .parser .before .after :-
	Parse.Atom .parser .atom !
	length .before .len,
	let .len1 (.len + 1), length .t .len1, -- New list with one more space
	(.len = 0; mnth .t 0 .len .before) ! -- Avoid calling mnth from 0 to 0
	nth .t .len .atom,
	Parse.TupleRemains .parser .t .after #
Parse.TupleRemains . .tuple .tuple #

Parse.Atom .parser (ID .a) :-
	parser.scanner .parser .sc, scan.match .sc (ID .a) ! #
Parse.Atom .parser (NUM .n) :-
	parser.scanner .parser .sc, scan.match .sc (NUM .n) ! #
Parse.Atom .parser (QUO .q) :-
	parser.scanner .parser .sc, scan.match .sc (QUO .q) ! #
Parse.Atom .parser (STR .s) :-
	parser.scanner .parser .sc, scan.match .sc (STR .s) ! #
Parse.Atom .parser $ :-
	parser.scanner .parser .sc, scan.match .sc (SYM "$") ! #
Parse.Atom .parser .tuple :- -- Brackets to define tuple
	parser.scanner .parser .sc,
	scan.match .sc (SYM "["),
	Parse.Tuple .parser .tuple,
	scan.match .sc (SYM "]") #
Parse.Atom .parser .tree :- -- Do parentheses ourselves to allow within tuple
	parser.scanner .parser .sc,
	scan.match .sc (SYM "("),
	parse.expression .parser .tree,
	scan.match .sc (SYM ")") #
